#TEMPLATE(ClarionTest, 'Clarion unit testing'),FAMILY('ABC')
#!---------------------------------------------------------------------
#PROCEDURE(TestProcedure, 'Test ADO Login Procedure'), PARENT(Source(ABC))
#DEFAULT
NAME DefaultTestProcedure
GLOBAL
CATEGORY 'Test procedures'
PROTOTYPE '(*long addr),long,pascal'
[COMMON]
DESCRIPTION 'Test Procedure'
FROM ABC Source
[PROMPTS]
%Parameters DEFAULT  ('(*long addr)')
[ADDITION]
NAME ClarionTest TestSupport
[INSTANCE]
INSTANCE 1
[WINDOW]
Window WINDOW('dummy ')
     END
#ENDDEFAULT
#!#Procedure(TestProcedure,'Source procedure for unit testing')
#!#DEFAULT
#!NAME DefaultTestProcedure
#!GLOBAL
#!CATEGORY 'Test procedures'
#!PROTOTYPE '(*long addr),long,pascal'
#![COMMON]
#!DESCRIPTION 'Source procedure for unit testing'
#!FROM ABC Source
#!#ENDDEFAULT
#!---------------------------------------------------------------------
#! Add necessary vars to support testing protocols
#!---------------------------------------------------------------------
#Extension(TestSupport,'Support testing protocol'),PROCEDURE
#Prepare
    #Insert(%Debug,'TestSupport PREPARE for procedure ' & %Procedure)
    #Insert(%ValidateTestProcParameters,%AddressVar)
#EndPrepare    
#Prompt('Address var',@s50),%AddressVar,Default('lpTestResults')
#AtStart
    #Insert(%Debug,'TestSupport ATSTART for procedure ' & %Procedure)
    #Insert(%ValidateTestProcParameters,%AddressVar)
#EndAt    
#At(%DataSection)
#Insert(%Debug,'TestSupport, generating data')
TestResult  &TestResultT
tr  &TestResult
#EndAt
#At(%ProcessedCode),first
    !-------------------------------------------------------------------
    ! Create a new instance of the class used to pass information
    ! back to the test runner and set some default values
    !-------------------------------------------------------------------
    TestResult &= new TestResultT
    TestResult.Passed = false ! default to failure
    TestResult.Message = 'Please set an appropriate result message'
    TestResult.ProcedureName = '%Procedure'
    TestResult.Description = '%ProcedureDescription'
    tr &= TestResult ! So you can use tr or TestResult in your code...
    %AddressVar = address(TestResult)
    !-------------------------------------------------------------------
    ! Write your code to test for a result. If the test failed,  set 
    ! the message to something descriptive. If the test passed,
    ! set tr.passed to true.
    !
    ! if (some condition failed)
    !     tr.Message = 'Expected A, got B'
    ! else
    !     tr.passed = true
    ! end
    !-------------------------------------------------------------------
#EndAt
#At(%ProcessedCode),last
    return 0
#EndAt    
#!---------------------------------------------------------------------
#Extension(TestSupportIncludes,'Add global include for test support'),APPLICATION
#At(%GlobalData)
    include('TestResult.inc'),once
#EndAt
#!---------------------------------------------------------------------
#! The following code could probably be handled nicely with a couple of
#! RegEx expressions - anybody want to tackle that?
#!---------------------------------------------------------------------
#Group(%ValidateTestProcParameters,* %AddressVar)
#Declare(%StartPos)
#Declare(%EndPos)
#Declare(%Param1)
#Declare(%Param1Type)
#Declare(%RetType)
#Insert(%Trace,'ValidateTestProcParameters')
#! Make sure the procedure name begins with TEST_
#Insert(%Trace,'ValidateTestProcParameters - checking procedure name ' & %Procedure)
#If( len(%Procedure) < 6 or lower(sub(%Procedure,1,5)) <> 'test_')
    #Error('Procedure "' & %Procedure & '" is misnamed. Test procedure names must begin with Test_')
    #! #Abort
#EndIf    
#! Make sure there's a (
#Insert(%Trace,'ValidateTestProcParameters - checking for (')
#Set(%StartPos,instring('(',%Prototype,1,1))
#If(%StartPos = 0)
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf    
#Set(%StartPos,%StartPos+1)
#! Get the contents inside the ()
#Insert(%Trace,'ValidateTestProcParameters, getting parameters')
#Set(%EndPos,instring(')',%Prototype,1,1))
#If(%EndPos = 0 or %EndPos =< %StartPos)
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf    
#Set(%Param1,sub(%Prototype,%StartPos,%EndPos - %StartPos))
#Insert(%Debug,'TempParam: ' & %Param1)
#! #! Make sure there's no , - i.e. only one parameter
#Insert(%Trace,'ValidateTestProcParameters - making sure there''s only one parameter')
#Insert(%Debug,'TempParam: ' & %Param1)
#Set(%StartPos,instring(',',%Param1,1,1))
#If(%StartPos > 0)
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf
#! Get the type and the label
#Insert(%Trace,'ValidateTestProcParameters - verifying both type and name are present')
#Set(%StartPos,instring(' ',%Param1,1,1))
#If(%StartPos = 0)
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf
#Insert(%Trace,'ValidateTestProcParameters - verifying the type is *long')
#Set(%Param1Type,sub(%Param1,1,%StartPos-1))
#Insert(%Debug,'Type is ' & upper(%Param1Type))
#If(lower(%Param1Type) <> '*long')
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf
#Set(%AddressVar,sub(%Param1,%StartPos+1,%len(%Param1)-%StartPos))
#Insert(%Debug,'Set addressvar to ' & %AddressVar)
#! Make sure there's a return type of long
#Set(%RetType,lower(sub(%Prototype,%EndPos+1,len(%Prototype)-%EndPos)))
#Insert(%Debug,'Set RetType to ' & %RetType)
#If(instring(',long',%RetType,1,1) > 0 and instring(',pascal',%RetType,1,1) > 0)
    #Insert(%Debug,'both ,long and ,pascal found')
#Else
    #Insert(%Debug,',long and ,pascal NOT both found')
    #Insert(%ValidateTestProcParametersCriticalError)
    #Return
#EndIf
#!---------------------------------------------------------------------
#Group(%ValidateTestProcParametersCriticalError)
#Error('The procedure ' & %Procedure & ' must have a prototype of (*long AnyVariableNameHere),long,pascal')
#! #Abort
#!-----------------------------------------------------------------------------
#Group(%Trace,%Msg)
#! #Message(%Msg,2)
#! #RUNDLL('TplDebug.DLL','ODS',%Msg),WIN32
#!-----------------------------------------------------------------------------
#Group(%Debug,%Msg)
#! #Message('*** ' & %Msg,2)
#!-----------------------------------------------------------------------------
#! #RUNDLL('TplDebug.DLL','ODS','[dbg] ' & %Msg),WIN32
#!-----------------------------------------------------------------------------
#!#PROCEDURE(ADOErrorsProc , 'ADO Errors Handling Procedure'), HLP('~TPLProcADOError')
#!#RESTRICT
#!  #FOR( %ApplicationTemplate )
#!    #IF(UPPER(SUB(%ApplicationTemplate,1,10)) = 'ADOSUPPORT')
#!      #ACCEPT
#!    #ENDIF
#!  #ENDFOR
#!  #REJECT  
#!#ENDRESTRICT
#!#DEFAULT
#!NAME DefaultCWADOError
#!GLOBAL
#!CATEGORY 'ADOError'
#!PROTOTYPE '(*CConnection pConn)'
#![COMMON]
#!DESCRIPTION 'ADO Errors Handling'
#!FROM CLARION Window
#![DATA]
#!ErrorQ                   QUEUE,PRE()
#!ErrorID                    LONG
#!ErrorDesc                  STRING(70)
#!                         END
#!oErrors                  &CErrors        ! Reference to the Errors Collection object
#!oError                   &CError         ! Reference to a single error contained in the Collection
#!ErrorCount               LONG ! Nbr of error in the collection
#!hr                       HRESULT         ! HRESULT var returned by methods call
#!lErrorID                 LONG ! Error ID returned by Number method
#!cstrDesc                 &Cstr           ! cstring class reference returned by CError.Description
#!ndx                      LONG
#![PROMPTS]
#!%WindowOperationMode STRING  ('Use WINDOW setting')
#!%INISaveWindow LONG  (1)
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#![ADDITION]
#!NAME CLARION_ADO ADOErrList
#![INSTANCE]
#!INSTANCE 1
#![PROMPTS]
#!%svConnObjectWithError DEFAULT  ('pConn')
#![ADDITION]
#!NAME CLARION CloseButton
#![INSTANCE]
#!INSTANCE 2
#![WINDOW]
#!Window WINDOW('Errors '),AT(,,397,161),FONT('MS Sans Serif',8,,FONT:regular,CHARSET:ANSI),GRAY,DOUBLE
#!       LIST,AT(7,7,381,118),USE(?List1),VSCROLL,TIP('Tips'),FORMAT('69R(2)|M~Error Number~@N-_15@20L(2)|MP~Error Description~@s70@'), |
#!           #SEQ(1),#ORIG(?List1)
#!       BUTTON('Close'),AT(343,134,45,14),USE(?Close),#SEQ(2),#ORIG(?Close)
#!     END
#!#ENDDEFAULT
#!---------------------------------------------------------------------
#!#PROCEDURE(TestADOLoginProc, 'TestADO Login Procedure'),WINDOW, PARENT(Window)
#!#DEFAULT
#!NAME TestDefaultADOLogin
#!GLOBAL
#!CATEGORY 'TestADOLogin'
#!PROTOTYPE '(*CConnection pConn), long'
#![COMMON]
#!DESCRIPTION 'Test ADO Login'
#!FROM ABC Window
#![DATA]
#!RetValue    long
#![PROMPTS]
#!%WindowOperationMode STRING  ('Use WINDOW setting')
#!%INISaveWindow LONG  (1)
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#!%ReturnValue DEFAULT (RetValue)
#![WINDOW]
#!Window WINDOW('Login '),AT(,,247,80),FONT('MS Sans Serif',8,,FONT:regular,CHARSET:ANSI),GRAY,DOUBLE
#!       PROMPT('&User ID'),AT(21,11),USE(?PromptUserID)
#!       ENTRY(@s20),AT(65,11,161,10),USE(szUserID)
#!       PROMPT('&Password:'),AT(21,23),USE(?PromptPassword)
#!       ENTRY(@s20),AT(65,23,161,10),USE(szPassword),PASSWORD
#!       PROMPT('&Server:'),AT(21,35),USE(?PromptServer)
#!       ENTRY(@s20),AT(65,35,161,10),USE(szServer)
#!       CHECK('Blank Password'),AT(23,54),USE(ulBlankPassword)
#!       BUTTON('&Login'),AT(133,53,45,14),USE(?btnLogin), DEFAULT
#!       BUTTON('Cancel'),AT(181,53,45,14),USE(?btnCancel)
#!     END
#!#ENDDEFAULT
#!
#!
#!#PROCEDURE(TestADOLoginProcB, 'TestADO Login Procedure'), PARENT(Source)
#!#DEFAULT
#!NAME TestDefaultADOLoginB
#!GLOBAL
#!CATEGORY 'TestADOLoginB'
#!PROTOTYPE '(*CConnection pConn), long'
#![COMMON]
#!DESCRIPTION 'Test ADO Login'
#!FROM ABC Source
#![PROMPTS]
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#![DATA]
#!dummy long
#!#ENDDEFAULT
#!#PROCEDURE(TestADOLoginProcD, 'Test ADO Login Procedure'),WINDOW, PARENT(Window(ABC))
#!#DEFAULT
#!NAME TestDefaultADOLoginD
#!GLOBAL
#!CATEGORY 'TestADOLoginC'
#!PROTOTYPE '(*CConnection pConn), long'
#![COMMON]
#!DESCRIPTION 'Test ADO Login '
#!FROM ABC Window
#![DATA]
#!RetValue    long
#![PROMPTS]
#!%WindowOperationMode STRING  ('Use WINDOW setting')
#!%INISaveWindow LONG  (1)
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#!%ReturnValue DEFAULT (RetValue)
#![WINDOW]
#!Window WINDOW('Login '),AT(,,247,80),FONT('MS Sans Serif',8,,FONT:regular,CHARSET:ANSI),GRAY,DOUBLE
#!       PROMPT('&User ID'),AT(21,11),USE(?PromptUserID)
#!       ENTRY(@s20),AT(65,11,161,10),USE(szUserID)
#!       PROMPT('&Password:'),AT(21,23),USE(?PromptPassword)
#!       ENTRY(@s20),AT(65,23,161,10),USE(szPassword),PASSWORD
#!       PROMPT('&Server:'),AT(21,35),USE(?PromptServer)
#!       ENTRY(@s20),AT(65,35,161,10),USE(szServer)
#!       CHECK('Blank Password'),AT(23,54),USE(ulBlankPassword)
#!       BUTTON('&Login'),AT(133,53,45,14),USE(?btnLogin), DEFAULT
#!       BUTTON('Cancel'),AT(181,53,45,14),USE(?btnCancel)
#!     END
#!#ENDDEFAULT
#!#PROCEDURE(TestADOLoginProcE, 'Test ADO Login Procedure'),WINDOW, PARENT(Window(ABC))
#!#DEFAULT
#!NAME TestDefaultADOLoginE
#!GLOBAL
#!CATEGORY 'TestADOLoginE'
#!PROTOTYPE '(*CConnection pConn), long'
#![COMMON]
#!DESCRIPTION 'Test ADO Login E'
#!FROM ABC Window
#![PROMPTS]
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#![WINDOW]
#!Window WINDOW('Login '),AT(,,247,80),FONT('MS Sans Serif',8,,FONT:regular,CHARSET:ANSI),GRAY,DOUBLE
#!       PROMPT('&User ID'),AT(21,11),USE(?PromptUserID)
#!       ENTRY(@s20),AT(65,11,161,10),USE(szUserID)
#!       PROMPT('&Password:'),AT(21,23),USE(?PromptPassword)
#!       ENTRY(@s20),AT(65,23,161,10),USE(szPassword),PASSWORD
#!       PROMPT('&Server:'),AT(21,35),USE(?PromptServer)
#!       ENTRY(@s20),AT(65,35,161,10),USE(szServer)
#!       CHECK('Blank Password'),AT(23,54),USE(ulBlankPassword)
#!       BUTTON('&Login'),AT(133,53,45,14),USE(?btnLogin), DEFAULT
#!       BUTTON('Cancel'),AT(181,53,45,14),USE(?btnCancel)
#!     END
#!#ENDDEFAULT
#!#PROCEDURE(TestADOLoginProcG, 'Test ADO Login Procedure'), PARENT(Source(ABC))
#!#DEFAULT
#!NAME TestDefaultADOLoginG
#!GLOBAL
#!CATEGORY 'TestADOLoginG'
#!PROTOTYPE '(*CConnection pConn), long'
#![COMMON]
#!DESCRIPTION 'Test ADO Login G'
#!FROM ABC Source
#![PROMPTS]
#!%Parameters DEFAULT  ('(*CConnection pConn)')
#![ADDITION]
#!NAME ClarionTest TestSupport
#![INSTANCE]
#!INSTANCE 1
#![WINDOW]
#!Window WINDOW('dummy ')
#!     END
#!#ENDDEFAULT
#!#PROCEDURE(TestADOLoginProcH, 'Test ADO Login Procedure'), PARENT(Source(ABC))
#!#DEFAULT
#!NAME TestDefaultADOLoginH
#!GLOBAL
#!CATEGORY 'TestADOLoginH'
#!PROTOTYPE '(*long addr),long,pascal'
#![COMMON]
#!DESCRIPTION 'Test ADO Login H'
#!FROM ABC Source
#![PROMPTS]
#!%Parameters DEFAULT  ('(*long addr)')
#![ADDITION]
#!NAME ClarionTest TestSupport
#![INSTANCE]
#!INSTANCE 1
#![WINDOW]
#!Window WINDOW('dummy ')
#!     END
#!#ENDDEFAULT
